Introduction

This recreates the Urban Institute’s Emergency Rental Assistance Priority Index for Louisville. The original index compares Louisville to the rest of Kentucky. At Greater Louisville Project, we think the more appropriate comparison is to our other peer cities. While the maps below show Louisville, the index values are based on a comparison to all census tracts in the core counties of our peer cities.

Greater Louisville Project has also aggregated the data up to the metro council district level. That data is available in both maps and tables.

In addition to the indexes, the indicators that make up the indexes are also mapped below. Navigation is based on tabs, so clicking on the small blue titles brings up the map related to each title.

Methods and Definitions

To produce an index with multiple indicators on different scales we used z-scores, which are a measure of how far away from average an observation is. For example, if looking at unemployment, we start with the unemployment rate in all tracts and the score for an individual tract is the number of standard deviations it is away from the average tract.

Data is from the Urban Institute’s Emergency Rental Assistance Priority Index and in most cases is tract level census data from 2018. The low income jobs lost to Covid is an Urban Institute constructed indicator. Complete details on the indicators can be found in the technical appendix, but they are summarized here for convenience.

Housing Instability Index

  • Poverty: Under the poverty line in the last 12 months
  • Percent Renting: The percent of households in the area who rent
  • Cost Burdened: Households making less than 35,000 and paying more than 50% of their income in rent
  • Overcrowding: Households renting and with more than 1.5 people per room.
  • Unemployed: In the labor force but not currently employed.

Covid Index

  • Health Insurance: Based on the noninstitutionalized population ages 19-64.
  • Low Income Job Loss from Covid: Estimated jobs lost to Covid based on previous Urban Institute Study

Equity Index

  • Percent Persons of Color: Percent of people in the area who identify as persons of color
  • Extremely Low Income: Renter occupied household making less than 30 percent of area median income
  • Public Assistance: Percent receiving some form of public assistance like SNAP or TANF
  • Foreign Born: Percent born outside the U.S.
library(tidyverse)
library(rgdal)
library(sf)
library(viridis)
library(magrittr)

df <- read_csv("housing_index_raw.csv")

# Filter to just peers
df_peer <- df %>% 
  filter(county_fips %in% c("1073", "18097", "21111", "26081", "29095", "29189",
                            "29510", "31055", "37081", "37119", "39049", "39061",
                            "40109", "40143", "45045", "47037", "47093", "47157")) %>%
  select(-contains("z_score"), -contains("index")) #drop index and z_score terms so we can recreate them

# Make z scores
make_z <- function(x){
  x <- (x - mean(x)) / sd(x)
}

df_z <- df_peer %>%
  mutate(across(where(is.numeric), make_z, .names = "z_{.col}"))

df_index <- df_z %>%
  mutate(
    housing_instability_index = z_perc_poverty_12mnth * .2 + z_perc_renters * .2 + z_perc_cost_burdened_under_35k * .2 + z_perc_overcrowding_renter_1.50_or_more * .2 + z_perc_unemployed_laborforce * .2,
    covid_index = z_perc_no_hinsure * .5 + z_perc_low_income_jobs_lost * .5,
    equity_index = z_perc_person_of_color * .5 + z_perc_30hamfi * .167 + z_perc_public_assistance * .167 + z_perc_foreign_born * .167,
    overall_index = housing_instability_index * .5 + covid_index * .1 + equity_index * .4
  )

Rental Insecurity Index

jfco_shp <- readOGR("JC Tracts", layer = "JC Tracts",
                     GDAL1_integer64_policy = TRUE, verbose = FALSE)

jfco_sf <- st_as_sf(jfco_shp) %>%
  mutate(GEOID = str_sub(GEO_ID, start = -11))

jfco_index <- df_index %>% 
  filter(county_fips == "21111") 

# Urban institute includes a greyed out flag for tracts without enough data
# It's easier to set the values to NA because the graphing framework has the ability to easily assign NA a different color
jfco_index <- jfco_index %>%
  mutate(across(where(is.numeric), ~if_else(jfco_index$grayed_out == 1, NA_real_, .)))
         
jfco_sf <- full_join(jfco_sf, jfco_index, by = "GEOID")

# Transform the percents
mult100 <- function(x){
  x <- x * 100
}

jfco_sf <- jfco_sf %>%
  mutate(across(starts_with("perc_"), mult100))

make_map <- function(indicator, title = "", legend = "", caption = "", no_legend = FALSE){
  plt <- ggplot(jfco_sf) + 
  geom_sf(aes(fill={{ indicator }} )) +
  # scale_fill_gradient(low = "#323844", high = "#d63631", name = "Percent") +
  scale_fill_viridis(na.value = "grey", name = legend) +
  theme_bw() +
  theme(panel.grid = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        panel.border = element_blank()) +
  labs(title = title,
       caption = caption)
  
  if (no_legend == TRUE){
    plt <- plt + theme(legend.position = "none")
  }
  
  return(plt)
}

make_map(overall_index, title = "Rental Insecurity Index", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher rental insecurity. \n This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

You can flip through the tabs below to see each of the three subindexes that make up the overall rental index.

Housing Instability Subindex

  • Share of people living in poverty
  • Share of renter-occupied housing units
  • Share of severely cost-burdened low-income renters
  • Share of severely overcrowded households
  • Share of unemployed people
make_map(housing_instability_index, title = "Housing Instability Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher housing instability. \n This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Covid 19 Impact Subindex

  • Share of adults without health insurance
  • Share of low-income jobs lost to Covid-19
make_map(covid_index, title = "Covid Instability Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher covid instability. \n This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Equity Subindex

  • Share of people of color
  • Share of extremely low-income renter households
  • Share of households receiving public assistance
  • Share of people born outside the United States
make_map(equity_index, title = "Equity Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher prioritization based on equity. \n This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Housing Instability Indicators

Poverty

make_map(perc_poverty_12mnth, title = "Poverty", 
         legend = "Percent", 
         caption = "Percent of each census tract that is in poverty. \n Data from Urban Institute.")

Percent Renting

make_map(perc_renters, title = "Percent of Renter Occupied Housing Units", 
         legend = "Percent", 
         caption = "Percent of each tract that rents. \n Data from Urban Institute")

Cost-burdened housholds

make_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k", 
         legend = "Percent", 
         caption = "Percent of households making less than 35,000 and paying more than 50% of their income in rent. \n Data from Urban Institute")

Overcrowding

make_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing", 
         legend = "Percent", 
         caption = "Percent of households renting and with more than 1.5 people per room. \n Data from Urban Institute")

Unemployed

make_map(perc_unemployed_laborforce, title = "Unemployment", 
         legend = "Percent", 
         caption = "Percent of people unemployed but still in the labor force (actively seeking work). \n Data from Urban Institute")

Covid Indicators

No Health Insurance

make_map(perc_no_hinsure, title = "No Health Insurance", 
         legend = "Percent", 
         caption = "Percent without health insurance. \n Data from Urban Institute")

Low Income Jobs Lost to Covid

make_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid", 
         legend = "Percent", 
         caption = "Estimate from the Urban Institute based on job categories in the each tract. \n Data from Urban Institute")

Equity Index

Percent PoC

make_map(perc_person_of_color, title = "Percent Persons of Color", 
         legend = "Percent", 
         caption = "Percent of persons in the area who identify as persons of color. \n Data from Urban Institute")

Extremely Low Income

make_map(perc_30hamfi, title = "Extremely Low Income", 
         legend = "Percent", 
         caption = "Renter occupied household making less than 30 percent of area median income. \n Data from Urban Institute")

Public Assistance

make_map(perc_public_assistance, title = "Recieving Public Assistance", 
         legend = "Percent", 
         caption = "Percent receiving some form of public assistance like SNAP or TANF. \n Data from Urban Institute")

Foreign Born

make_map(perc_foreign_born, title = "Foreign Born", 
         legend = "Percent", 
         caption = "Percent born outside the U.S. \n Data from Urban Institute")

Peer City Data

Peer city data is available for the housing stability subindex.

# set up fonts
library(showtext)
showtext_auto()

font_add("Montserrat", "Montserrat/Montserrat-Regular.ttf")
font_add("Montserrat Bold", "Montserrat/Montserrat-SemiBold.ttf")

# Ranking graph function
ranking <- function(df, var, plot_title = "",
                    year = NULL, sex = "total", race = "total",
                    order = "Descending",
                    y_title = "Percent", caption_text = "", subtitle_text = "",
                    bar_label = TRUE, sigfig = 3, accuracy = 0.1,
                    label_function, alternate_text = NULL,
                    ranking_colors = TRUE, text_size){
  # Copy variable var to a new column for use with the '$' operator
  var <- dplyr:::tbl_at_vars(df, vars(!!enquo(var)))
  df$var <- df[[var]]
  # Filter to sex, race, and year
  if ("sex" %in% names(df)) df <- df[df$sex == sex,]
  if ("race" %in% names(df)) df <- df[df$race == race,]
  if("year" %in% names(df)) {
    if (is.null(year)) year <- max(years_in_df(df, var))
    df <- df[df$year %in% year,]
    if (length(year) > 1) {
      df %<>%
        group_by_at(df %cols_in% c("MSA", "FIPS")) %>%
        summarise(var = mean(var, na.rm = TRUE)) %>%
        ungroup()
    }
  }
  # Add peer data if not already present
  # if (df_type(df) %in% c("FIPS", "MSA") & "current" %not_in% names(df)) df %<>% pull_peers(add_info = T)
  
  # Sort according to order parameter
  if (order %in% c("descending", "Descending")) df %<>% arrange(desc(var))
  if (order %in% c("ascending", "Ascending"))   df %<>% arrange(var)
  df %<>% filter(!is.na(var))
  # Create numbered city labels for left side of graph
  df %<>%
    mutate(
      rank = row_number(),
      names = paste0(rank, ". ", city))
  # Set bar colors
  if (ranking_colors) {
    # color_values <- c("#96ca4f", "#ffd600", "#db2834")
    # color_names <- c("green", "yellow", "red")
    # if (order %in% c("descending", "Descending")) {color_names  = rev(color_names)}
    # 
    # breaks <- classInt::classIntervals(na.omit(df$var), 3, style = "jenks")
    # df$color <- NA
    # df$color[df$var <= breaks$brks[2]] <- color_names[1]
    # df$color[df$var > breaks$brks[2] & df$var <= breaks$brks[3]] <- color_names[2]
    # df$color[df$var > breaks$brks[3]] <- color_names[3]
    
    color_values <- c("#d63631", "#323844")
    color_names <- c("gray", "red")
    
    df$color <- "red"
    df$color[df$city == "Louisville"] <- "gray"
  } else {
    df$color <- "blue"
    color_values <- "#f58021"
    color_names <- "blue"
  }
  if (order %in% c("descending", "Descending")) color_values = rev(color_values)
  # Create numeric labels
  # Create numeric labels
  if (!missing(label_function)) {
    label_text <- df$var %>% signif(sigfig) %>% label_function()
  } else if (y_title == "Dollars") {
    if(mean(df$var, na.rm = TRUE) > 10000) {
      label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = accuracy, scale = .001, suffix = "k")
    } else {
      label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = .01)
    }
  } else if (stringr::str_detect(y_title, "Percent")) {
    label_text <- df$var %>% signif(sigfig) %>% scales::percent(accuracy = accuracy, scale = 1, suffix = "%")
  } else {
    label_text <- df$var %>% signif(sigfig) %>% scales::comma(accuracy = accuracy)
  }

  # Set text format, highlight and italicise Louisville text, highlight Louisville bar
  df$textcolor <- "#000000"
  df$textcolor[df$city == "Louisville"] <- "#000000"
  
  df$textfont <- "Montserrat"
  df$textfont[df$city == "Louisville"] <- "Montserrat Bold"
  
  label_color_names <- c("white", "black")
  label_color_values <- c("#000000", "#ffffff")
  
  df$label_color <- "white"
  df$label_color[df$city == "Louisville"] <- "black"
  #df$linecolor <- "#ffffff"
  #df$linecolor[df$city == "Louisville"] <- "#00a9b7"
  df$lou <- if_else(df$city == "Louisville", 1, 0)
  df$text_alignment <- 1.1
  if (!is.null(alternate_text)) df$text_alignment[df$rank %in% alternate_text] <- -0.1
  ### PLOT GRAPH
  
  # Initial plot
  p <- ggplot(data = df,
              aes(x = factor(names, levels = rev(names)),
                  y = var,
                  fill  = factor(color, levels = color_names, ordered = TRUE)))
  p <- p + guides(fill = FALSE, color = FALSE)
  # Add bars
  p <- p +
    geom_bar(stat = "identity",
             size = text_size) +
    coord_flip() +
    ggthemes::theme_tufte()
  p <- p + scale_fill_manual(values = color_values)
  #p <- p + scale_color_manual(values = c("#ffffff", "#00a9b7"))
  # Add features
  title_scale <- min(1, 48 / nchar(plot_title))
  p <- p + theme(text = element_text(family = "Montserrat"),
                 plot.title = element_text(size = 14 * title_scale * text_size, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
                 axis.text.y = element_text(hjust = 0,
                                            size = 10 * text_size, 
                                            color = rev(df$textcolor),
                                            family = rev(df$textfont)),
                 axis.title.x = element_text(size = 10 * text_size),
                 axis.ticks = element_blank(),
                 axis.text.x = element_blank(),
                 plot.caption = element_text(size = 5 * text_size, lineheight = 0.5))
  if(subtitle_text != ""){
    p <- p + theme(plot.subtitle = element_text(hjust = 0.5, size = 5 * text_size)) +
      labs(subtitle = subtitle_text)
  }
  # Add numeric labels to bars based on bar_label parameter
  if (y_title != "" & bar_label) {
    p <- p + geom_text(aes(label = label_text, 
                           hjust = text_alignment, 
                           color = factor(label_color),
                           family = textfont),
                       size = 5 * text_size) +
       scale_colour_manual(values=c("#000000", "#ffffff"))
    }
  # Add vertical line to the left side of the bars based on the h_line parameter
  if (min(df$var, na.rm = TRUE) < 0) p <- p + geom_hline(yintercept = 0, linetype = "longdash", size = 2)
  # Add remaining text
  p <- p + labs(title = plot_title, y = y_title,
                x = "", caption = caption_text)
  
  p
}

Cost Burdened Renters

#Data was pulled in Python file get_data.py and written to .csv
df <- read_csv("low_income_renters.csv")

## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R

# Calculate percent of households making under 35k who pay more than 50% of their
# income on rent
df <- df %>%
  # select ACS table variables w/ attached GEOID
  select(
    NAME,
    # These are all the peolpe making under 35k (denominator)
    B25074_002E,
    B25074_011E,
    B25074_020E,
    # These are all the people making under 35k who pay more than 50% of their income on rent (numerator)
    B25074_009E,
    B25074_018E,
    B25074_027E,
    # These are the people making under 35k for whom this metric wasn't computed
    # and they therefore need to be subtracted from the denominator
    B25074_010E,
    B25074_019E,
    B25074_028E
  )  %>%
  #rename both county and city to just St. Louis
  mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
  group_by(NAME) %>%
  #use summarize across instead to save space and make reusable in a function
  summarize(
    B25074_002E = sum(B25074_002E),
    B25074_011E = sum(B25074_011E),
    B25074_020E = sum(B25074_020E),
    B25074_009E = sum(B25074_009E),
    B25074_018E = sum(B25074_018E),
    B25074_027E = sum(B25074_027E),
    B25074_010E = sum(B25074_010E),
    B25074_019E = sum(B25074_019E),
    B25074_028E = sum(B25074_028E)
  ) %>%
  # create cost burden variable w/ calculation
  mutate(
    perc_cost_burdened_under_35k = (B25074_009E + B25074_018E + B25074_027E) /
      (
        B25074_002E + B25074_011E + B25074_020E - B25074_010E - B25074_019E -
          B25074_028E
      ),
    #cd add
    perc_cost_burdened_under_35k =
      if_else(
        B25074_002E + B25074_011E + B25074_020E == 0,
        0,
        perc_cost_burdened_under_35k
      )
  )

# Clean up for graph
df <- df %>%
  mutate(city = recode(NAME,
                       `Davidson County, Tennessee` = "Nashville",
                       `Douglas County, Nebraska` = "Omaha",
                       `Franklin County, Ohio` = "Columbus",
                       `Greenville County, South Carolina` = "Greenville",
                       `Guilford County, North Carolina` = "Greensboro",
                       `Hamilton County, Ohio` = "Cincinnati",
                       `Jackson County, Missouri` = "Kansas City",
                       `Jefferson County, Alabama` = "Birmingham",
                       `Jefferson County, Kentucky` = "Louisville",
                       `Kent County, Michigan` = "Grand Rapids",
                       `Knox County, Tennessee` = "Knoxville",
                       `Marion County, Indiana` = "Indianapolis",
                       `Mecklenburg County, North Carolina` = "Charlotte",
                       `Oklahoma County, Oklahoma` = "Oklahoma City",
                       `Shelby County, Tennessee` = "Memphis",
                       `Tulsa County, Oklahoma` = "Tulsa"),
         perc_cost_burdened_under_35k = 100 * perc_cost_burdened_under_35k) 

plt_cost_burdened <- ranking(df, "perc_cost_burdened_under_35k", text_size = 1, order = "ascending",
                             plot_title = "Cost Burdened Renters in Households Making Under 35k ")

plt_cost_burdened

Overcrowding

#Data was pulled in Python file get_data.py and written to .csv
oc_df <- read_csv("overcrowding.csv")

## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R

oc_df <- oc_df %>%
  # select ACS table variables w/ attached GEOID
  select(NAME, B25014_013E, B25014_012E, B25014_008E)  %>%
  #rename both county and city to just St. Louis
  mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
  group_by(NAME) %>%
  summarize(across(where(is.numeric), sum)) %>%
   # create cost burden variable w/ calculation
  mutate(perc_overcrowding_renter_1.50_or_more = ((B25014_012E + B25014_013E) / B25014_008E),
         perc_overcrowding_renter_1.50_or_more = 
           if_else(B25014_008E == 0, 0, perc_overcrowding_renter_1.50_or_more))

# Clean up for graph
oc_df <- oc_df %>%
  mutate(city = recode(NAME,
                       `Davidson County, Tennessee` = "Nashville",
                       `Douglas County, Nebraska` = "Omaha",
                       `Franklin County, Ohio` = "Columbus",
                       `Greenville County, South Carolina` = "Greenville",
                       `Guilford County, North Carolina` = "Greensboro",
                       `Hamilton County, Ohio` = "Cincinnati",
                       `Jackson County, Missouri` = "Kansas City",
                       `Jefferson County, Alabama` = "Birmingham",
                       `Jefferson County, Kentucky` = "Louisville",
                       `Kent County, Michigan` = "Grand Rapids",
                       `Knox County, Tennessee` = "Knoxville",
                       `Marion County, Indiana` = "Indianapolis",
                       `Mecklenburg County, North Carolina` = "Charlotte",
                       `Oklahoma County, Oklahoma` = "Oklahoma City",
                       `Shelby County, Tennessee` = "Memphis",
                       `Tulsa County, Oklahoma` = "Tulsa"),
         perc_overcrowding_renter_1.50_or_more = 100 * perc_overcrowding_renter_1.50_or_more) 

plt_oc <- ranking(oc_df, "perc_overcrowding_renter_1.50_or_more", text_size = 1, order = "ascending",
                             plot_title = "Overcrowding")

plt_oc

Unemployment

#Data was pulled in Python file get_data.py and written to .csv
un_df <- read_csv("unemployed.csv")

## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
un_df <- un_df %>%
  # select ACS table variables w/ attached GEOID
  select(B12006_055E, B12006_050E, B12006_011E, B12006_006E, B12006_022E, B12006_017E, B12006_033E, B12006_028E, B12006_044E, B12006_039E, B12006_053E, B12006_048E, B12006_009E, B12006_004E, B12006_020E, B12006_015E, B12006_031E, B12006_026E, B12006_042E, B12006_037E, NAME) %>%
  # collapse St. Louis into one
  mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
  group_by(NAME) %>%
  summarize(across(where(is.numeric), sum)) %>%
  # create unemployed variable w/ calculation
  mutate(perc_unemployed_laborforce = ((B12006_055E + B12006_050E + B12006_011E + B12006_006E + B12006_022E + B12006_017E + B12006_033E + B12006_028E + B12006_044E + B12006_039E) / (B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E)),
         perc_unemployed_laborforce = 
           if_else(B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E == 0, 0,
                   perc_unemployed_laborforce))

# Clean up for graph
un_df <- un_df %>%
  mutate(city = recode(NAME,
                       `Davidson County, Tennessee` = "Nashville",
                       `Douglas County, Nebraska` = "Omaha",
                       `Franklin County, Ohio` = "Columbus",
                       `Greenville County, South Carolina` = "Greenville",
                       `Guilford County, North Carolina` = "Greensboro",
                       `Hamilton County, Ohio` = "Cincinnati",
                       `Jackson County, Missouri` = "Kansas City",
                       `Jefferson County, Alabama` = "Birmingham",
                       `Jefferson County, Kentucky` = "Louisville",
                       `Kent County, Michigan` = "Grand Rapids",
                       `Knox County, Tennessee` = "Knoxville",
                       `Marion County, Indiana` = "Indianapolis",
                       `Mecklenburg County, North Carolina` = "Charlotte",
                       `Oklahoma County, Oklahoma` = "Oklahoma City",
                       `Shelby County, Tennessee` = "Memphis",
                       `Tulsa County, Oklahoma` = "Tulsa"),
         perc_unemployed_laborforce = 100 * perc_unemployed_laborforce) 

plt_un <- ranking(un_df, "perc_unemployed_laborforce", text_size = 1, order = "ascending",
                             plot_title = "Unemployed")

plt_un

Share renting

#Data was pulled in Python file get_data.py and written to .csv
sr_df <- read_csv("share_renting.csv")

## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
sr_df <- sr_df %>%
  # select ACS table variables w/ attached GEOID
  select(B25003_003E, B25003_001E, NAME) %>%
  # collapse St. Louis into one
  mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
  group_by(NAME) %>%
  summarize(across(where(is.numeric), sum)) %>%
  # create perc_renters variable w/ calculation
  mutate(perc_renters = (B25003_003E / B25003_001E),
         perc_renters = if_else(B25003_001E == 0, 0, perc_renters),
         num_renters = B25003_003E)

# Clean up for graph
sr_df <- sr_df %>%
  mutate(city = recode(NAME,
                       `Davidson County, Tennessee` = "Nashville",
                       `Douglas County, Nebraska` = "Omaha",
                       `Franklin County, Ohio` = "Columbus",
                       `Greenville County, South Carolina` = "Greenville",
                       `Guilford County, North Carolina` = "Greensboro",
                       `Hamilton County, Ohio` = "Cincinnati",
                       `Jackson County, Missouri` = "Kansas City",
                       `Jefferson County, Alabama` = "Birmingham",
                       `Jefferson County, Kentucky` = "Louisville",
                       `Kent County, Michigan` = "Grand Rapids",
                       `Knox County, Tennessee` = "Knoxville",
                       `Marion County, Indiana` = "Indianapolis",
                       `Mecklenburg County, North Carolina` = "Charlotte",
                       `Oklahoma County, Oklahoma` = "Oklahoma City",
                       `Shelby County, Tennessee` = "Memphis",
                       `Tulsa County, Oklahoma` = "Tulsa"),
         perc_renters = 100 * perc_renters) 

plt_sr <- ranking(sr_df, "perc_renters", text_size = 1, order = "ascending",
                             plot_title = "Percent Renters")

plt_sr

Poverty

#Data was pulled in Python file get_data.py and written to .csv
pv_df <- read_csv("poverty.csv")

## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
pv_df <- pv_df %>%
  # select ACS table variables w/ attached GEOID
select(C17002_002E, C17002_003E, C17002_001E, NAME) %>%  
  # collapse St. Louis into one
  mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
  group_by(NAME) %>%
  summarize(across(where(is.numeric), sum)) %>%
  # create poverty variable w/ calculation
  mutate(perc_poverty_12mnth = ((C17002_002E + C17002_003E) / C17002_001E),
         perc_poverty_12mnth = 
           if_else(C17002_001E == 0, 0, perc_poverty_12mnth))

# Clean up for graph
pv_df <- pv_df %>%
  mutate(city = recode(NAME,
                       `Davidson County, Tennessee` = "Nashville",
                       `Douglas County, Nebraska` = "Omaha",
                       `Franklin County, Ohio` = "Columbus",
                       `Greenville County, South Carolina` = "Greenville",
                       `Guilford County, North Carolina` = "Greensboro",
                       `Hamilton County, Ohio` = "Cincinnati",
                       `Jackson County, Missouri` = "Kansas City",
                       `Jefferson County, Alabama` = "Birmingham",
                       `Jefferson County, Kentucky` = "Louisville",
                       `Kent County, Michigan` = "Grand Rapids",
                       `Knox County, Tennessee` = "Knoxville",
                       `Marion County, Indiana` = "Indianapolis",
                       `Mecklenburg County, North Carolina` = "Charlotte",
                       `Oklahoma County, Oklahoma` = "Oklahoma City",
                       `Shelby County, Tennessee` = "Memphis",
                       `Tulsa County, Oklahoma` = "Tulsa"),
         perc_poverty_12mnth = 100 * perc_poverty_12mnth) 

plt_pv <- ranking(pv_df, "perc_poverty_12mnth", text_size = 1, order = "ascending",
                             plot_title = "Poverty")

plt_pv

Metro Council District Maps

Rental Insecurity Index

# Read in cross walk
tract_to_district <- read_csv("district_tract_crosswalk.csv") %>%
  mutate(tract = as.character(tract))

# Join to data
district_level <- df_index %>%
  rename(tract = GEOID) %>%
  # Remove airport to avoid dividing by zero
  filter(tract!= "21111980100") %>%
  # join crosswalk data to dataframe
  left_join(tract_to_district, by = "tract") %>%   
  # Group by district
  group_by(district) %>%
  # join crosswalk data to dataframe
  summarise(across(where(is.numeric), ~sum(. * total)), .groups = "drop")

# Shape files
metro_shp <- readOGR("Council_Districts", layer = "council_districts",
                     GDAL1_integer64_policy = TRUE, verbose = FALSE)

metro_sf <- st_as_sf(metro_shp) %>%
  rename(district = coundist)

metro_sf <- full_join(metro_sf, district_level, by = "district")

# Transform the percents
mult100 <- function(x){
  x <- x * 100
}

# Replicate binary decision tree to determine most-interior point of polygons
# This runs well enough for me, but nothing appears when I try using it in the code below
buffers <- c()
for(d in 1:26) {
  buff_max = -0.06
  buff_min = 0
  this_buffer = buff_min
  this_step = buff_max
  current_resolution = 11
  
  while(current_resolution > 10){
  
    #browser()
    # Buffer inside the polygon using this_buffer
    temp_sf <- st_buffer(metro_sf[d,], dist = this_buffer, singleSide = T) 
  
    # Calculate area of polygon
    temp_area = st_area(temp_sf) %>% as.numeric()
    
    # If remaining area > 0, enlarge buffer by going away from 0. 
    #   Also record most recent correct buffer and area produced by buffer.
    # If remaining area is 0, reduce buffer by going toward 0.
    if (temp_area > 0) {
      current_result = this_buffer
      current_resolution = temp_area
      
      this_buffer = this_buffer + this_step
    } else {
      this_buffer = this_buffer - this_step
    }
    
    # Cut search step in half
    this_step = this_step / 2
  }
  
  buffers <- c(buffers, current_result)
  
}

metro_sf <- metro_sf %>%
  mutate(across(starts_with("perc_"), mult100))

metro_map <- function(indicator, title = "", legend = "", caption = "", no_legend = FALSE){
  plt <- ggplot(metro_sf) + 
  geom_sf(aes(fill={{ indicator }} )) +
  # Add District labels 
  geom_sf_text(aes(label = district), color = "white") +
  #geom_sf_text(aes(label = district), family = "Montserrat Bold", fontface = "bold", size = 6, color = "#ffffff",
  #             fun.geometry = function(x) st_buffer(x, dist = buffers, singleSide = T) %>% st_point_on_surface()) +
  # scale_fill_gradient(low = "#323844", high = "#d63631", name = legend) +
  scale_fill_viridis(na.value = "grey", name = legend) +
  theme_bw() +
  theme(panel.grid = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        panel.border = element_blank()) +
  labs(title = title,
       caption = caption)
  
  if (no_legend == TRUE){
    plt <- plt + theme(legend.position = "none")
  }
  
  return(plt)
}

metro_map(overall_index, title = "Rental Insecurity Index", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher rental insecurity. \n This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Housing Instability Subindex

metro_map(housing_instability_index, title = "Housing Instability Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher housing instability. \n This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Covid 19 Impact Subindex

metro_map(covid_index, title = "Covid Instability Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher covid instability. \n This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Equity Subindex

metro_map(equity_index, title = "Equity Subindex", 
         legend = "Compared to \n other tracts", 
         caption = "Lighter shades indicate higher prioritization based on equity. \n This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
         no_legend = TRUE)

Poverty

metro_map(perc_poverty_12mnth, title = "Poverty", 
         legend = "Percent", 
         caption = "Percent of each census tract that is in poverty. \n Data from Urban Institute.")

Percent Renting

metro_map(perc_renters, title = "Percent of Renter Occupied Housing Units", 
         legend = "Percent", 
         caption = "Percent of each tract that rents. \n Data from Urban Institute")

Cost-burdened housholds

metro_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k", 
         legend = "Percent", 
         caption = "Percent of households making less than 35,000 and paying more than 50% of their income in rent. \n Data from Urban Institute")

Overcrowding

metro_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing", 
         legend = "Percent", 
         caption = "Percent of households renting and with more than 1.5 people per room. \n Data from Urban Institute")

Unemployed

metro_map(perc_unemployed_laborforce, title = "Unemployment", 
         legend = "Percent", 
         caption = "Percent of people unemployed but still in the labor force (actively seeking work). \n Data from Urban Institute")

No Health Insurance

metro_map(perc_no_hinsure, title = "No Health Insurance", 
         legend = "Percent", 
         caption = "Percent without health insurance. \n Data from Urban Institute")

Low Income Jobs Lost to Covid

metro_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid", 
         legend = "Percent", 
         caption = "Estimate from the Urban Institute based on job categories in the each tract. \n Data from Urban Institute")

Percent PoC

metro_map(perc_person_of_color, title = "Percent Persons of Color", 
         legend = "Percent", 
         caption = "Percent of persons in the area who identify as persons of color. \n Data from Urban Institute")

Extremely Low Income

metro_map(perc_30hamfi, title = "Extremely Low Income", 
         legend = "Percent", 
         caption = "Renter occupied household making less than 30 percent of area median income. \n Data from Urban Institute")

Public Assistance

metro_map(perc_public_assistance, title = "Recieving Public Assistance", 
         legend = "Percent", 
         caption = "Percent receiving some form of public assistance like SNAP or TANF. \n Data from Urban Institute")

Foreign Born

metro_map(perc_foreign_born, title = "Foreign Born", 
         legend = "Percent", 
         caption = "Percent born outside the U.S. \n Data from Urban Institute")

Metro Council Tables

Housing Subindex

library(gt)

metro_house_tbl <- metro_sf %>%
  st_drop_geometry() %>%
  filter(!is.na(district)) %>%
  select(district, perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index) %>%
  #GT fmt_percent expects percents as decimals
  mutate(across(starts_with("perc"), ~ ./100)) %>%
  gt() %>%
  tab_header(title = "Table 1: Housing Indicators",
             subtitle = "Components of the Housing Instability Subindex") %>%
  fmt_number(columns = vars(housing_instability_index),
             n_sigfig = 2,
             suffixing = TRUE) %>%
  fmt_percent(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more),
              decimals = 0) %>%
  cols_label(district = "Metro District",
             perc_cost_burdened_under_35k = "Cost Burdened",
             perc_renters = "Renting", 
             perc_poverty_12mnth = "Poverty", 
             perc_unemployed_laborforce = "Unemployed", 
             perc_overcrowding_renter_1.50_or_more = "Overcrowding",
             housing_instability_index = "Index") %>%
  cols_move(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index),
            after = vars(district)) %>%
  tab_spanner(
    label = "Index",
    columns = vars(housing_instability_index)
  ) %>%
  tab_spanner(
    label = "Percent",
    columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more)
  ) %>%
  cols_align(align = "center") %>%
    tab_source_note(
    source_note = md("Greater Louisville Project")
  ) %>%
  tab_source_note(
    source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
  ) %>%
  opt_row_striping(row_striping = TRUE) %>%
  opt_table_outline() %>%
  tab_options(
    table.font.size = px(12),
    table.width = pct(50)
  ) 

metro_house_tbl
Table 1: Housing Indicators
Components of the Housing Instability Subindex
Metro District Percent Index
Cost Burdened Renting Poverty Unemployed Overcrowding Index
1 47% 45% 24% 12% 0% 0.22
2 51% 50% 20% 8% 3% 0.33
3 46% 47% 26% 10% 1% 0.27
4 35% 80% 43% 17% 1% 0.97
5 47% 57% 34% 17% 1% 0.73
6 40% 77% 43% 11% 1% 0.75
7 64% 27% 6% 3% 0% −0.35
8 38% 32% 9% 3% 1% −0.46
9 41% 42% 10% 4% 0% −0.36
10 47% 41% 15% 6% 0% −0.15
11 32% 29% 7% 4% 1% −0.49
12 49% 32% 12% 6% 2% −0.16
13 35% 39% 17% 6% 1% −0.21
14 50% 23% 16% 5% 0% −0.32
15 41% 55% 26% 9% 1% 0.28
16 66% 19% 5% 4% 1% −0.32
17 64% 26% 7% 3% 1% −0.31
18 56% 37% 5% 3% 1% −0.29
19 70% 21% 4% 4% 1% −0.29
20 47% 17% 4% 3% 1% −0.57
21 50% 49% 22% 6% 1% 0.077
22 36% 21% 6% 3% 2% −0.51
23 41% 19% 6% 4% 1% −0.52
24 48% 37% 14% 5% 1% −0.12
25 34% 34% 11% 5% 1% −0.39
26 52% 40% 12% 4% 1% −0.18
Greater Louisville Project
Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.

Covid Subindex

metro_covid_tbl <- metro_sf %>%
  st_drop_geometry() %>%
  filter(!is.na(district)) %>%
  select(district, perc_no_hinsure, perc_low_income_jobs_lost, covid_index) %>%
  #GT fmt_percent expects percents as decimals
  mutate(across(starts_with("perc"), ~ ./100)) %>%
  gt() %>%
  tab_header(title = "Table 2: Covid Indicators",
             subtitle = "Components of the Covid Subindex") %>%
  fmt_number(columns = vars(covid_index),
             n_sigfig = 2,
             suffixing = TRUE) %>%
  fmt_percent(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost),
              decimals = 0) %>%
  cols_label(district = "Metro District",
             perc_no_hinsure = "No Health Insurance", 
             perc_low_income_jobs_lost = "Covid Job Loss", 
             covid_index = "Covid Index") %>%
  cols_move(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost, covid_index),
            after = vars(district)) %>%
  tab_spanner(
    label = "Index",
    columns = vars(covid_index)
  ) %>%
  tab_spanner(
    label = "Percent",
    columns = vars(perc_no_hinsure, perc_low_income_jobs_lost)
  ) %>%
  cols_align(align = "center") %>%
  tab_source_note(
    source_note = md("Greater Louisville Project")
  ) %>%
  tab_source_note(
    source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
  ) %>%
  opt_row_striping(row_striping = TRUE) %>%
  opt_table_outline() %>%
  tab_options(
    table.font.size = px(12),
    table.width = pct(50)
  ) 

metro_covid_tbl
Table 2: Covid Indicators
Components of the Covid Subindex
Metro District Percent Index
No Health Insurance Covid Job Loss Covid Index
1 9% 9% −0.18
2 14% 8% −0.012
3 10% 9% −0.098
4 10% 10% −0.011
5 10% 9% −0.082
6 11% 9% 0.0010
7 6% 9% −0.20
8 4% 9% −0.34
9 7% 9% −0.22
10 9% 9% −0.20
11 5% 9% −0.41
12 7% 8% −0.42
13 13% 8% −0.17
14 8% 8% −0.42
15 12% 9% −0.046
16 4% 10% −0.24
17 5% 10% −0.16
18 5% 9% −0.28
19 3% 9% −0.36
20 3% 8% −0.49
21 14% 8% −0.017
22 5% 8% −0.44
23 7% 8% −0.38
24 9% 8% −0.29
25 8% 8% −0.38
26 9% 9% −0.17
Greater Louisville Project
Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.

Equity Index

metro_equity_tbl <- metro_sf %>%
  st_drop_geometry() %>%
  filter(!is.na(district)) %>%
  select(district, perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index) %>%
  #GT fmt_percent expects percents as decimals
  mutate(across(starts_with("perc"), ~ ./100)) %>%
  gt() %>%
  tab_header(title = "Table 3: Equity Indicators",
             subtitle = "Components of the Equity Subindex") %>%
  fmt_number(columns = vars(equity_index),
             n_sigfig = 2,
             suffixing = TRUE) %>%
  fmt_percent(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born),
              decimals = 0) %>%
  cols_label(district = "Metro District",
             perc_person_of_color = "Person of Color", 
             perc_30hamfi = "Extremely Low Income", 
             perc_public_assistance = "Public Assistance", 
             perc_foreign_born = "Foreign Born", 
             equity_index = "Index") %>%
  cols_move(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index),
            after = vars(district)) %>%
  tab_spanner(
    label = "Index",
    columns = vars(equity_index)
  ) %>%
  tab_spanner(
    label = "Percent",
    columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index)
  ) %>%
  cols_align(align = "center") %>%
  tab_source_note(
    source_note = md("Greater Louisville Project")
  ) %>%
  tab_source_note(
    source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
  ) %>%
  opt_row_striping(row_striping = TRUE) %>%
  opt_table_outline() %>%
  tab_options(
    table.font.size = px(12),
    table.width = pct(50)
  ) 

metro_equity_tbl
Table 3: Equity Indicators
Components of the Equity Subindex
Metro District Percent
Person of Color Extremely Low Income Public Assistance Foreign Born Index
1 68% 43% 2% 2% 0.48
2 69% 28% 2% 18% 0.67
3 66% 45% 4% 4% 0.57
4 60% 50% 4% 4% 0.53
5 74% 45% 3% 1% 0.63
6 53% 46% 3% 5% 0.38
7 16% 11% 1% 7% −0.71
8 7% 15% 1% 3% −0.92
9 15% 19% 2% 5% −0.67
10 28% 28% 2% 9% −0.28
11 23% 11% 2% 8% −0.53
12 27% 26% 3% 5% −0.32
13 31% 23% 5% 12% −0.035
14 15% 28% 4% 3% −0.51
15 38% 32% 5% 8% 0.11
16 18% 8% 1% 8% −0.67
17 25% 15% 2% 10% −0.43
18 20% 12% 1% 11% −0.57
19 17% 14% 1% 6% −0.71
20 16% 17% 1% 4% −0.74
21 44% 29% 2% 19% 0.28
22 22% 13% 1% 5% −0.63
23 23% 16% 2% 6% −0.54
24 31% 26% 3% 11% −0.13
25 24% 20% 2% 6% −0.49
26 26% 20% 4% 13% −0.19
Greater Louisville Project
Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.